home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / fill.tcl < prev    next >
Encoding:
Text File  |  1996-01-10  |  7.6 KB  |  312 lines  |  [TEXT/ALFA]
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 3/7/95 {7:49:47 pm} 
  6. #                                last update: 6/10/95 {10:41:50 am} 
  7. #  Author: Vince Darley
  8. #  E-mail: <mailto:vince@das.harvard.edu>
  9. #    mail: Division of Applied Sciences, Harvard University
  10. #          Oxford Street, Cambridge MA 02138, USA
  11. #  <http://www.das.harvard.edu/users/students/Vincent_Darley/>
  12. #  
  13. ####################################################################
  14.  
  15.  
  16. proc fillParagraph {} {
  17.     if {[getPos] == [selEnd]} {
  18.         fillOneParagraph
  19.     } else {    
  20.         set start [getPos]
  21.         set end [selEnd]
  22.         set p $start
  23.         while { $p < $end } {
  24.             goto $p
  25.             set p [fillParagraph]
  26.         }
  27.         goto $start
  28.     }
  29. }
  30.  
  31. proc fillOneParagraph {} {
  32.     global leftFillColumn fillColumn
  33.     
  34.     getWinInfo a
  35.     set tabs $a(tabsize)
  36.  
  37.     set pos [getPos]
  38.     # find nearest text to grab hold of 
  39.     # to try and maintain cursor position
  40.     if { [lookAt $pos] != " " } {
  41.         set grab [getText $pos [expr $pos +20]]
  42.         set grabdiff 0
  43.     } else {
  44.         backwardWord
  45.         set p2 [getPos]
  46.         set grab [getText $p2 [expr $pos +20]]
  47.         set grabdiff [expr $pos - $p2]
  48.     }
  49.     
  50.     set start [paraStart $pos] 
  51.     set end [paraFinish $pos]
  52.     # get the leading whitespace of the current line
  53.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  54.     
  55.     # convert it to minimal form: tabs then spaces, stored in 'front'
  56.     set sp [string range "              " 1 $tabs ]
  57.     regsub -all $sp [eval getText $res] "\t" front
  58.     regsub -all "\[ \]+\t" $front "\t" front
  59.     # get the length of the indent
  60.     regsub -all "\t" $front $sp lfront
  61.     set left [string length $lfront]
  62.  
  63.     # fill the text
  64.     regsub -all "\[ \t\r\]+" [string trim [getText $start $end]] " " text
  65.     # turn single spaces at end of sentences into double
  66.     regsub -all {(([^A-Z@]|\\@)[.?!]([])]|'|'')?) } $text {\1  } text
  67.     
  68.     # temporarily adjust the fillColumns
  69.     set ol $leftFillColumn
  70.     set or $fillColumn
  71.     set leftFillColumn 0
  72.     set fillColumn [expr $fillColumn - $left]
  73.         
  74.     # break and indent the paragraph
  75.     regsub -all "\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
  76.     
  77.     # don't replace if nothing's changed
  78.     if { "$text\r" != "\r[getText $start $end]" } {
  79.         replaceText $start $end "[string range "$text" 1 end]\r"
  80.         set p [fillFind $text $grab]
  81.         if { $p == -1 } {
  82.             goto $pos
  83.         } else {
  84.             goto [expr $start + $p + $grabdiff -1]
  85.         }
  86.     }
  87.     
  88.     set leftFillColumn $ol
  89.     set fillColumn  $or
  90.     # in case we wish to fill a region
  91.     return $end
  92. }
  93.  
  94.  
  95. proc fillFind { text search } {
  96.     if { ![string length $search] } {
  97.         return -1
  98.     }
  99.     
  100.     set pos [string first $search $text]
  101.     if { $pos != -1 } {
  102.         return $pos
  103.     } else {
  104.         set search [string range $search 0 [expr [string length $search] -5]]
  105.         return [fillFind $text $search]
  106.     }
  107. }
  108.  
  109. set texParaCommands {begin|end|(protect\\)?label|(sub)*section|subfigure|paragraph|center(line|ing)|caption|chapter|item|bibitem|intertext}
  110.  
  111. proc paraStart {pos} {
  112.     global mode texParaCommands
  113.     if {$pos == [maxPos]} {incr pos -1}
  114.     set pos [lineStart $pos]
  115.     if { $mode == "TeX" || $mode == "Bib" } {
  116.         set startPara {(\\\\[ \t]*$|^[ \t]*(\$\$[ \t]*|(%+.*|(\\(}
  117.         append startPara $texParaCommands {)(\[.*\]|\{.*\}|Ñ)*[ \t]*)+))?$)}
  118.     } else {
  119.         set startPara {^([ \t]*|([\\%].*))$}
  120.     }
  121.     set res [search -s -n -f 0 -r 1 -l 0 "$startPara" $pos]
  122.     if {![string length $res] || $res == "0 0" } {return 0}
  123.     if { [lindex $res 0] == $pos } {
  124.         return $pos
  125.     } else {
  126.         return [nextLineStart [lindex $res 0]]
  127.     }
  128.     
  129. }
  130.  
  131. proc paraFinish {pos} {
  132.     global mode texParaCommands
  133.     set pos [lineStart $pos]
  134.     set end [maxPos]
  135.     if { $mode == "TeX" || $mode == "Bib" } {
  136.         set endPara {^[ \t]*(\$\$[ \t]*|(%+.*|(\\(}
  137.         append endPara $texParaCommands {)(\[.*\]|\{.*\}|Ñ)*[ \t]*)+))?$}
  138.     } else {
  139.         set endPara {^([ \t]*|([\\%].*))$}
  140.     }
  141.     
  142.     set res [search -s -n -f 1 -r 1 -l $end "$endPara" $pos]
  143.     if {![string length $res]} {return $end}
  144.     if { [lindex $res 0] == $pos } {
  145.         return [nextLineStart $pos]
  146.     }
  147.     # a line which ends in '\\' or '%' also signifies end of line in tex mode
  148.     if { $mode == "TeX" || $mode == "Bib" } {
  149.         set res2 [search -s -n -f 1 -r 1 -l $end {(\\\\|%)[ \t]*$} $pos]
  150.         if [string length $res2] {
  151.             if { [lindex $res2 0] < [lindex $res 0] } {
  152.                 return [nextLineStart [lindex $res2 0]]
  153.             }
  154.         }
  155.     }
  156.  
  157.     return [lindex $res 0]
  158.     
  159. }
  160.  
  161.  
  162. proc sentenceParagraph {} {
  163.     set pos [getPos]
  164.     set start [paraStart $pos] 
  165.     set finish [paraFinish $pos]
  166.  
  167.     set t [string trim [getText $start $finish]]
  168.     set period [regexp {\.$} $t]
  169.     regsub -all "\[ \t\r\]+" $t " " text
  170.     regsub -all {\. } $text "╞" text
  171.     set result ""
  172.     foreach line [split [string trimright $text {.}] "╞"] {
  173.         if {[string length $line]} {
  174.             append result [breakIntoLines $line] ".\r"
  175.         }
  176.     }
  177.     if {!$period && [regexp {\.\r} $result]} {
  178.         set result [string trimright $result ".\r"]
  179.         append result "\r"
  180.     }
  181.     if {$result != [getText $start $finish]} {
  182.         replaceText $start $finish $result
  183.     }
  184.     goto $pos
  185. }
  186.  
  187. proc getEndpts {} {
  188.     if {[getPos] == [selEnd]} {
  189.         set start [getPos]
  190.         set finish [getMark]
  191.         if {$start > $finish} {
  192.             set temp $start
  193.             set start $finish
  194.             set finish $temp
  195.         }
  196.     } else {
  197.         set start [getPos]
  198.         set finish [selEnd]
  199.     }
  200.     return [list $start $finish]
  201. }
  202.  
  203.  
  204. proc fillRegion {} {
  205.         global leftFillColumn
  206.         set ends [getEndpts]
  207.         set start [lineStart [lindex $ends 0]]
  208.         set finish [lindex $ends 1]
  209.         goto $start
  210.         set text [fillText $start $finish]
  211.         replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  212. }
  213.     
  214. proc wrapParagraph {} {
  215.     set pos [getPos]
  216.     set start [paraStart $pos] 
  217.     set finish [paraFinish $pos]
  218.     goto $start
  219.     wrapText $start $finish
  220.     goto $pos
  221. }
  222.  
  223. proc wrapRegion {} {
  224.     set ends [getEndpts]
  225.     set start [lineStart [lindex $ends 0]]
  226.     set finish [lindex $ends 1]
  227.     if {$start == $finish} {
  228.         set finish [maxPos]
  229.     }
  230.     wrapText $start $finish
  231. }
  232.     
  233.  
  234.  
  235. # Remove text from window, transform, and insert back into window.
  236. proc fillText {from to} {
  237.     set text [getText $from $to]
  238.     regexp {^ *} $text front
  239.     set text [string trim $text]
  240.     regsub -all "\[ \t\r\]+" $text " " text
  241.     regsub -all {(\.|\?|\!) } $text {\1  } text
  242.     regsub -all "\r" [string trimright [breakIntoLines $text]] "\r${front}" text
  243.     return $front$text
  244. }
  245.  
  246. proc paragraphToLine {} {
  247.     global fillColumn
  248.     global leftFillColumn
  249.     set fc $fillColumn
  250.     set lc $leftFillColumn
  251.     set fillColumn 10000
  252.     set leftFillColumn 0
  253.     fillRegion
  254.     set fillColumn $fc
  255.     set leftFillColumn $lc
  256. }
  257.  
  258. proc lineToParagraph {} {
  259.     global fillColumn
  260.     global leftFillColumn
  261.     set fc $fillColumn
  262.     set fillColumn 75
  263.     set lc $leftFillColumn
  264.     set leftFillColumn 0
  265.     fillRegion
  266.     set fillColumn $fc
  267.     set leftFillColumn $lc
  268. }
  269.  
  270.  
  271. #set sentEnd {[.!?](\r| +)}
  272. set sentEnd {(\r\r|[.!?](\r| +))}
  273. set sentBeg {[\r ][A-Z]}
  274.  
  275. proc nextSentence {} {
  276.     global sentBeg sentEnd
  277.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  278.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  279.             goto [expr [lindex $mtch 0]+1]
  280.         }
  281.     }
  282. }
  283.  
  284.  
  285. proc prevSentence {} {
  286.     global sentBeg sentEnd
  287.     if {[catch {search -s -f 0 -r 1 $sentBeg [expr [getPos]-2]} mtch]} return
  288.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  289.         if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [expr [lindex $mtch 1]-1]} mtch]} {
  290.             goto [expr [lindex $mtch 0]+1]
  291.         }
  292.     }
  293. }
  294. # 5 730 845 955
  295.  
  296. #===============================================================================
  297. # Called by Alpha to do "soft wrapping"
  298. proc softProc {pos start next} {
  299.     global leftFillColumn
  300.     goto $start
  301.     set finish [paraFinish $start]
  302.     set text [fillText $start $finish]
  303.     if {"${text}\r" != [getText $start $finish]} {
  304.         replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  305.         return 1
  306.     } else {
  307.         return 0
  308.     }
  309. }
  310.  
  311.  
  312.